Compendium Deluxe 1/LSD Compendium Deluxe 1.iso/a/programming/arexx/arexg10c.lha/ARexxGuide/Extras/ARx_Help.ttx

Text File | 1993-10-14 | 19.9 KB | 611 lines

/** $VER: ARx_Help.ttx 1.1 (14 Oct 1993)
 ** by Robin Evans (based on getxref.ttx by David N. Junod)
 **
 ** Display the ARexxGuide page for the word currently under the
 ** cursor.
 **
 ** Add the following line to your TTX_Startup.dfn file, in the KEYBOARD:
 ** section.
 **
 **     HELP               ExecARexxMacro "ARx_Help" SYNC
 **     SHIFT-HELP         ExecARexxMacro "ARx_Help" ASYNC
 **
 ** You may want to add the following lines to your S:user-startup file.
 **
 **   RXLIB amigaguide.library 0 -30
 **
 ** Be careful with that library, however. I've found that it interferes
 ** in some cases with rexxarplib.library. If that happens, it can be
 ** removed with this shell command:
 **
 **   RX "remlib('amigaguide.library')
 **
 **  The AmigaGuide/path environmental variable must include the directory
 **  where arx_guide.xref is located.
 **  the ARexxGuide/AGCmd environmental variable must include the name
 **  of the command used to launch amigaguide files.
 **/

signal on syntax
signal on break_c
signal on halt
signal on failure

   /* If you'd rather not use rexxarplib, see the alternative subroutine **
   ** for ShowInfo: near line 340. If you uncomment the alternative,     **
   ** then rexxarplib won't be needed. Delete the following two lines to **
   ** keep it from being loaded.                                         */
if ~show('L','rexxarplib.library') then
    call addlib('rexxarplib.library',0,-30)

TRUE=1; FALSE=0

   /* We're using SetInputLock, so we should make sure it doesn't stay on */
signal on break_c
signal on halt
signal on syntax
signal on failure

options results
parse arg Mode LkUp

if ~show('L','amigaguide.library') then
    call addlib('amigaguide.library',0,-30)

if ~show('L','rexxsupport.library') then
    call addlib('rexxsupport.library',0,-30)

   /* Did they pass a word? */
if LkUp = '' then do

      /* Get all the line info we'll need and lock out input until **
      ** it's all collected.                                       **
      ** Check for special characters first                        */
   'SetInputLock on'
   'GetLine 1'
   HLine = Tab2Space(result)
   'GetCursorPos'
   CurPos = word(result, 2)
   'SetInputLock off'
      /* Show the index requester if it's a blank line */
   if HLine = '' | verify(HLine, ' ;') = 0 then do
      call ShowInfo(,, CurPos, Kwd)
      exit
   end
      /* CurPos won't match ARexx count if tabs are used        **
      ** this will break if a semicolon is used within a string **
      ** but checking for that seems like overkill.             */
   SemPos = lastpos(';', HLine, CurPos) + 1
   Kwd = upper(word(HLine, 1))
   if SemPos > 1 then
      if SemPos < CurPos + 1 then do
         parse var HLine =SemPos HLine ';'
         CurPos = CurPos - SemPos + 1
      end                                /* Hex characters:  ' ? ! . SpTbRt    */
   MChar = pos(substr(HLine,CurPos,1), '+-/*|&^><=,;:~)("'||'273F212E20090a'x)
   select
      when MChar = 0 then do
            /* Look for whole word if it isn't a special character */
         'GetWord'
         LkUp = result
      end
      when MChar <= 2 then
         if Kwd = 'PARSE' then
            LkUp = 'PARSETMP5'
         else
            LkUp = 'ARITHMETIC'
      when MChar <= 4 then do
            /* This picks up the three characters surrounding a '*' or '/' */
         ComChar = substr(HLine, max(1, CurPos - 1), 3)
         if pos('/*', ComChar) + pos('*/', ComChar) > 0 then
            LkUp = 'COMMENT'
         else
            LkUp = 'ARITHMETIC'
      end
      when MChar <= 7 then
         LkUp = 'LOGICAL'
      when MChar <= 9 then
         LkUp = 'COMPARISON'
      when MChar = 10 then
         if Kwd = 'PARSE' then
            LkUp = 'PARSETMP5'
         else if symbol(strip(left(HLine, max(1, CurPos-1)))) == 'BAD' then
            LkUp = 'COMPARISON'
         else
            LkUp = 'ASSIGNMENT'
      when MChar = 11 then
         LkUp = 'COMMA'
      when MChar = 12 then
         LkUp = 'SEMICOLON'
      when MChar = 13 then
         LkUp = 'LABEL'
      when MChar = 14 then do    /* Tilde           */
            /* is the next character a comparison operator? */
         if pos(substr(HLine, CurPos , 2), '~=~>~<') > 0 then
            LkUp = 'COMPARISON'
         else
            LkUp = 'LOGICAL'
      end
      when MChar <=16 then
         if Kwd = 'PARSE' then
            LkUp = 'PARSETMP5'
         else
            LkUp = 'PAREN'
      when MChar <= 18 then      /* Quotation marks */
         LkUp = 'STRING'
      when MChar = 19 then       /* ? */
          if Kwd = 'TRACE' then
              LkUp = 'TRACEOPT1'
          else
              LkUp = '?'
      when MChar = 20 then            /* ! */
          if Kwd = 'TRACE' then
              LkUp = 'TRACEOPT2'
          else
              LkUp = '!'
        when MChar = 21 then do   /* . -- dot  */
                /* Get the surrounding ARexx token */
            StPos = verify(' 'HLine, '+-|/&=~\><^,;:()"'' ', 'M', lastpos(' ', ' 'HLine, CurPos))
            Token = substr(HLine, StPos, verify(HLine' ', '+-|/&=~\><^,;:()"'' ', M, CurPos) - StPos)
            if Token = '.' then
                if Kwd = 'PARSE' then
                    LkUp = 'PARSETMP2'
                else
                    LkUp = Token
            else
               LkUp = Token
      end
      otherwise /* At a space or EOL */
         if CurPos >= wordindex(HLine, 1) then do
            'GetWord'
            LkUp = result
         end
         else do
            call ShowInfo(HLine,, CurPos, Kwd)
            exit
         end
   end
end
   /* Show that we're doing something */
'SetStatusBar TEMPORARY Checking for 'LkUp'...'

   /* See if the ARexxGuide cross-reference table is loaded **
    ** Look for a ref that's not likely to be dup. in other  **
   ** xref files.                                           */
if getxref('TRACEOPT2') = 10 then do
      /* Show that we're doing something */
   'SetStatusBar TEMPORARY Loading cross-reference file...'
      /* The ARexxGuide table wasn't loaded, so load it. */
   if ~LoadXRef('ARx_Guide.xref') then
       signal XRefError
end

if word(HLine, 1) ~= LkUp then do CheckOpt = 1 for 1    /* Let's us leave */
   if GetXRef(LkUp) = 10 | find('ARG PULL UPPER COMMAND', upper(LkUp)) > 0 then do
      if word(GetXRef(Kwd),3) = 2 then select
         when Kwd = 'DO' then do
            SpecWord = find('UNTIL WHILE TO FOR BY FOREVER ', upper(LkUp))
            if SpecWord > 0 then
               LkUp = word('DOOPT4 DOOPT4 DOOPT2 DOOPT3 DOOPT2 DOOPT5', SpecWord)
         end
         when Kwd = 'PARSE' then do
            SpecWord = find('ARG PULL EXTERNAL NUMERIC SOURCE VERSION VALUE VAR WITH', upper(LkUp))
            if SpecWord > 0 then do
               LkUp = 'PARSESRC'SpecWord
               if SpecWord = 9 then
                  LkUp = 'PARSESRC7'
            end
            else
                LkUp = 'PARSETMP1'
         end
         when Kwd = 'OPTIONS' then
            if find('RESULTS PROMPT FAILAT CASHE ON OFF', upper(LkUp)) > 0 then
               LkUp = Kwd
         when Kwd = 'TRACE' then
            if verify(upper(left(LkUp,1)), 'IRACLENOBS') = 0 then
               LkUp = 'TRACEOPT'
         when Kwd = 'SIGNAL' then
            if find('ON OFF', upper(LkUp)) >0 then
               LkUp = 'SIGTRAP'
            else if pos('BREAK_', upper(LkUp)) = 1 then
                LkUp = 'BREAK_'
            else
                LkUp = 'SIGTRAN'
         when upper(LkUp) = 'UPPER' then
            if Kwd ~= 'UPPER' then
               LkUp = 'UPPER()'
         when Kwd = 'ADDRESS' then
             if abbrev(word(HLine, 2), LkUp) then do
                 LkUp = Kwd
                 leave CheckOpt  /* so we don't get address() */
             end
         otherwise
      end
      if GetXRef(LkUp'()') ~= 10 then
         LkUp = LkUp'()'
   end
end


if open(.GtEnv, 'env:arexxguide/agcmd', R) then do
    AGCmd = readln(.GtEnv)
    call close .GtEnv
end
else
    signal NoCmd

if abbrev(AGCmd, 'Multi') then
   PrtOpt = ''
else
   PrtOpt = 'portname ARX_GUIDE'

if GetXRef(LkUp) = 10 then
   call ShowInfo HLine, LkUp, CurPos, Kwd
else do
      /* Show that we're doing something. Tells type of node being loaded */
   'SetStatusBar ARexxGuide: 'upper(LkUp) '['word('Explanation Function Instruction', word(getxref(LkUp), 3)+1)']'

   Cmd = ''

      /* See if our AG window is open */
   if ~show('P','ARX_GUIDE') then do
      if Cmd = '' then
         Cmd = 'run' AGCmd 'document' LkUp PrtOpt 'requester'

      address command cmd
   end
   else do

         /* What command do we use to show the node */
      LinkCmd = "Link"
      if mode = "ASYNC" then
         LinkCmd = "ALink"

         /* show the node */
      address ARX_GUIDE LinkCmd LkUp
      address ARX_GUIDE 'unzoomwindow'
      address ARX_GUIDE 'windowtofront'
   end
end

exit

XRefError:
    ErrLine = SIGL
    ErrMsg.0 = 5
    ErrMsg.2 = 'Unable to load the cross-reference file ARx_Guide.xref'
    if ~exists('env:amigaguide/path') then
        ErrMsg.3 = 'Your environmental variable "amigaguide/path" is not set.'
    else
        ErrMsg.3 = '   Be sure to include that file''s directory in env:amigaguide/path.'
    ErrMsg.4 = '   The .xref file may be put into the current directory or into'
    ErrMsg.5 = '   any directory included in the amigaguide/path environmental variable.'
    signal PutErrMsg
NoCmd:
    ErrLine = SIGL
    ErrMsg.0 = 4
    ErrMsg.2 = 'Can''t read environmental variable "env:arexxguide/AGcmd".'
    ErrMsg.3 = '   That variable must hold the name of the command you use'
    ErrMsg.4 = '   to show AmigaGuide files.'
    signal PutErrMsg
Syntax:
    ErrLine = SIGL
    ErrMsg.0 = 2
    ErrMsg.2 = '   Syntax error #'rc ':' errortext(rc)
    Signal PutErrMsg
Failure:
    ErrMsg.0 = 2
    ErrMsg.2 = '   Command "'sourceline(SIGL)'" failed.'
    ErrLine = SIGL
    Signal PutErrMsg
Halt:
Break_C:
    ErrMsg.0 = 2
    ErrMsg.2 = '   Execution halted.'
    ErrLine = SIGL
PutErrMsg:
    call trace b
    ErrMsg.1 ='Sorry an enexpected error has occured in line' ErrLine'.'

    signal off syntax
    signal off halt
    signal off break_c
    WinHi = 48 + ErrMsg.0 * 11
    'SetStatusBar ARx_Help.ttx error.'
    if open(.ErrWin, 'con:0/0/640/'WinHi'/Arx_Help Error/CLOSE') then do
        do i = 1 to ErrMsg.0
            call writeln(.ErrWin, ErrMsg.i)
        end
        call writech(.ErrWin, '0a'x'               Press <Enter>')
        call readln(.ErrWin)
    end
exit 0

Tab2Space:  procedure
   parse arg line
   'GetPrefs tabwidth'
   tabsize = result
   tpos=pos('09'x,Line);
   do while tpos>0;
      Line=insert('',Line, tpos, min(1, tpos//tabsize)*(tabsize-tpos//tabsize));
      tpos=pos('09'x, Line,tpos+1);
   end;
return translate(Line,' ','09'x)

/*  If you'd rather not use rexxarplib, or don't care to wait for all the **
**  info collected in the subroutine, then you could uncomment this       **
**  section. It's OK to leave the rest of the file in place, since ARexx  **
**  will call only the first of two subroutines that use the same name.   **
**  If you don't use it, though, this file will load faster if you get rid**
**  of everthing below the 'return 0'                                     */
/*
  ShowInfo:

   'RequestBool "'center(upper(LkUp) 'not found.',37)'" "'center('Show ARexxGuide index?',37)'"'
   if result = 'YES' then do
      XMatch = TRUE; LkUp = 'ARx_Index/MAIN'
      Cmd = 'run' AGCmd 'ARx_Index' PrtOpt 'requester'
   end
return 0

*/

ShowInfo: procedure expose AGCmd

   parse arg HLine, LkUp, CurPos, Kwd
      /* Show that we're doing something */
   'SetStatusBar TEMPORARY "'LkUp'" not found. Checking clause...'

   if ~abbrev(AGCmd, 'Multi') then
      ExecStr='ExecARexxString address ARXTTX quit; if ~show(P, ARX_GUIDE) then do;address command; run "'getenv("arexxguide/AGCmd") 'ARexxGuide.guide portname ARX_GUIDE";waitforport ARX_GUIDE; end; address ARX_GUIDE; windowtofront;'
   else
      ExecStr = 'ExecARexxString address ARXTTX quit; address command; run "'AGCmd'"ARexxGuide.guide"'

      /* figure out what type of clause the current line is */
   select
      when word(HLine, 2) = '=' then do
         CType = 2
      end
      when pos('/*', HLine) < CurPos & pos('/*', HLine) ~= 0 then
         if pos('*/', HLine) > CurPos | pos('*/', HLine) = 0 then
            CType = 4
      when getxref(word(HLine,1)) ~= 10 then do
         Xref = getxref(word(HLine,1))
         if word(Xref,3) = 2 then
            CType = 1
      end
      when right(word(HLine,1), 1) = ':' then
         CType = 3
      when HLine = '' then
         CType = 5
      otherwise
         CType = 0
         EqPos = pos('=', HLine)
         if EqPos > 0 then do
            if symbol(strip(left(HLine, EqPos-1))) ~= 'BAD' then do
               HLine=insert(' ', HLine, EqPos - 1)
               HLine = insert(' ', HLine, EqPos + 2)
               CType = 2
            end
         end
   end
   if CType = 2 then
      if ~IsVar(word(HLine, 1)) then
         CType = 0
   /* Prepare the window gadgets */
   CName.0 = 'Command'
   CName.1 = 'Instruction'
   CName.2 = 'Assignment'
   CName.3 = 'Label'
   CName.4 = 'Comment'
   CName.5 = 'Null'
   Gad. = ''
   Gad.1.6Txt = 'Current clause is'
   Gad.1.6Btn = CName.CType
   Gad.1.6Cmd = ExecStr 'link' CName.CType
   Gadgets = 1
   select
      when CType = 1 then do
         Gad.2.6Txt = 'Current keyword is'
         Gad.2.6Btn = Kwd
         Gad.2.6Cmd = ExecStr 'link' Kwd
         Gadgets = 2
      end
      when CType = 3 then do
         Gad.2.6Txt = 'Name of subroutine:' word(HLine,1)'.'
         Gadgets = 2
      end
          /* happens when cursor is at the end of a comment */
      when ~datatype(CType, 'N') then
          Gadgets = 0
      otherwise
   end

         /* Figure out what the current word is doing */
         /* Use variables to make the bit settings more obvious */

   FuncName = 0; FuncArg = 1; Str = 2; Var = 3; Num=4; Hex=5; Bin=6; Cnst=7; Cmpd = 8
   if CType <= 3 & LkUp > '' then do
         /* Split the string so we can compare both sides */
      parse var HLine LStr =CurPos RStr
         /* Get only the portion of the string which contains LkUp */
      WdRange = substr(HLine, max(1, CurPos - length(LkUp)), length(LkUp) *2)

         /* Use Bit functions to keep multiple matches */
      WType = null()||null() /* Using more than 8 bytes */
         /* Is it a string in single quotes ? */
      if IsVar(LkUp) then do
         WType = bitset(WType, Var)
         if Kwd = 'CALL' then
             if abbrev(word(HLine, 2), LkUp) then
                 WType = bitset(WType, FuncName)
             else
                 WType = bitset(Wtype, FuncArg)
      end
      if verify(HLine, '"''', M) > 0 then do
         if CountChar(LStr, "'")//2 then do
            WType = bitset(WType, Str)
               /* Is it a quoted function name? */
            if pos(LkUp"'(", WdRange) & bittst(WType, Var) then
                  WType = bitset(WType, FuncName)
            else if datatype(LkUp, X) then
               if pos(LkUp"'X", upper(HLine)) > 0 then
                  WType = bitset(WType, Hex)
            else if datatype(LkUp, B) then
               if pos(LkUp"'B", upper(WdRange)) > 0 then
                  WType = bitset(WType, Bin)
         end
            /* Is it a string in double quotes? */
         else if CountChar(LStr, '"')//2 then do
            WType = bitset(WType, Str)
            if pos(LkUp'"(', WdRange) & bittst(WType, Var) then
                  WType = bitset(WType, FuncName)
            else if datatype(LkUp, X) then
               if pos(LkUp'"X', upper(HLine)) then
                  WType = bitset(WType, Hex)
            else if datatype(LkUp, B) then
               if pos(LkUp'"B', upper(WdRange)) > 0 then
                  WType = bitset(WType, Bin)
         end
         if bittst(WType, Str) then
            WType = bitclr(WType, Var)
      end
         /* Is current word enclosed in parens? */
      if verify(HLine, "()", M) > 0 then do
         if CountChar(LStr, "(") - CountChar(LStr, ")") > 0 then
               WType = bitset(WType, FuncArg)
         if pos(LkUp'(', WdRange) > 0 & bittst(WType, Var) then
               WType = bitset(WType, FuncName)
      end

         /* is it a number or constant? */
      if datatype(LkUp, N) then do
            /* Make sure it isn't already a hex or bin string */
         if ~bittst(WType, Hex) & ~bittst(WType, Bin) then
               WType = bitset(WType, Num)
      end
         /* compare String/Var. If it isn't one of those it's a constant */
      else if ~bittst(WType, Var) then do
         if ~bittst(WType, Str) then
            WType = bitset(WType, Cnst)
      end
      else if pos('.', LkUp) > 0 then
          WType = bitset(WType, Cmpd)
         /* it could have been assigned FuncName in either check above **
         ** In either case, a Function name isn't a variable           */
      if bittst(WType, FuncName) then
         WType = bitclr(WType, Var)
      if CType = 3 then
          if abbrev(Kwd, upper(LkUp)) then
              WType = null()

         /** Prepare gadgets to explain current word **/
      if WType ~= null() then do
         interpret 'Gad.'Gadgets+1'.6Txt = ''"''Lkup''" is'''
         if bittst(WType, FuncName) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Function name'
            Gad.Gadgets.6Cmd = ExecStr 'link FUNCTION'
         end
         if bittst(WType, FuncArg) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Function argument'
            Gad.Gadgets.6Cmd = ExecStr 'link FUNCARG'
         end
         if bittst(WType, Str) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'String'
            Gad.Gadgets.6Cmd = ExecStr 'link STRINGEXPR'
         end
         if bittst(WType, Hex) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Hex string'
            Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
         end
         if bittst(WType, Bin) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Binary string'
            Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
         end
         if bittst(WType, Var) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Variable'
            Gad.Gadgets.6Cmd = ExecStr 'link VARIABLE'
         end
         if bittst(WType, Cmpd) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn= 'Compound variable'
            Gad.Gadgets.6Cmd = ExecStr 'link COMPVAR'
         end
         if bittst(WType, Num) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Number'
            Gad.Gadgets.6Cmd = ExecStr 'link NUMBER'
         end
         if bittst(WType, Cnst) then do
            Gadgets = Gadgets + 1
            Gad.Gadgets.6Btn = 'Constant symbol'
            Gad.Gadgets.6Cmd = ExecStr 'link CONSTANT'
         end
      end
   end
      /* Open the rexxarplib requester window */
   CPort = 'ARXTTX'
   if ~InfoWin(CPort, Gadgets+2, 'Lookup:' LkUp) then return 10


   x = 10; y = 32

   do i = 1 to Gadgets
      move(CPort, x, y)
      if Gad.i.6Btn = '' then
         Txt = center(Gad.i.6Txt,47)
      else
         Txt = right(Gad.i.6Txt, 21)
      call Text(CPort, Txt)
      if Gad.i.6Btn > '' then
         call AddGadget(CPort, 192, y - 9, i, ' 'left(Gad.i.6Btn, 26),Gad.i.6Cmd)
      y = y + 15
   end
   call AddGadget(CPort, 10, y-4, 14, ' View ARexxGuide index ',ExecStr '"link Arx_Index/MAIN"')
   call AddGadget(CPort, 344, y-4, 15, ' Cancel ', 'ExecARexxString address ARXTTX quit')


return 0

InfoWin: procedure

   parse arg CPort, Rows, WinTitle

   PoC = address()
      /** shut down previous requester if it's still around **/
   if show(P, CPort) then do; address value CPort; quit; address; end
   'GetWindowInfo'
   x= word(result,3); y= word(result,3)
   'GetScreenInfo'
   PubScreen = word(result, words(result))
      /* change notifyport (PoC) to a port read by this script */
   address ARexx "'call CreateHost("CPort"," PoC", "PubScreen")'"
      /**   Open the window   **/
   idcmp = 'CLOSEWINDOW+GADGETUP'
   flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+ACTIVATE'
   address command 'waitforport' CPort
   Height = 16+15*Rows
   if rc = 0 then do
      call OpenWindow(CPort, x, y, 422, Height, idcmp,flags, WinTitle)
      call SetAPen(CPort, 2)
      call SetNotify(CPort, CLOSEWINDOW, CPort)
      return 1
   else
      return 0

CountChar:

   parse arg IStr, Char
return length(IStr) - length(compress(IStr, Char))

IsVar:
   call trace b
   return symbol(arg(1)) ~== 'BAD' & datatype(left(arg(1),1), m)